00100	C  SUBRS.  SLUR, PLTSRT, (LINES, RDRAW)
00200	
00300		SUBROUTINE SLUR
00400		IMPLICIT INTEGER(A-Q,T-Z)
00500		COMMON/SLR/ SLURX(72) /ALF/INP,SLURY(72)
00600		REAL CENTR
00700		COMMON /PLTR/PLT,RHT,RDIS
00800		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
00900		1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
01000		1 J5,J6,J7,J8,J9,J10,J11,JQ(7),R,RJ
01100		COMMON/PTR/PWDS(250),ITEM,L,I,IX /STF/RSTFAC(-3/4),RSTJ2
01200	CF	DATA RZZ/2.8/
01300	C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8
01400	
01500		IF(JA.NE.12)GO TO 2
01600	CF	RA=5.96*RSJT2*R5
01700	CF	L=3
01800	CF	J8=J8*RDIS
01900	CF	IF(J7.LE.J6)J7=J7+360
02000	CF	KQ=6
02100	CF	IF(PLT)KQ=1
02200	CF10	DO 3 K=J6,J7,KQ
02300	CF	R=K
02400	CF	CALL LINES(R3+RA*SIND(R),CENTR+RA*COSD(R),L)
02500	CF3	L=2
02600	CF	J8=J8-1
02700	CF	IF(J8)RETURN
02800	CF	RA=RA+1/RDIS
02900	CF	L=3
03000	CF	GO TO 10
03100	CJA=12  DRAWS CIRCLES. P5=RADIUS, P6=DEGR.1, P7=DEGR.2,P8=THICK(EXPANDS
03200		CALL CIRCLE
03300		RETURN
03400	
03500	2	J10=1
03600		J4=-1
03700		KQ=6
03800		TWICE=-1
03900	C  -1 FOR DISPLAY, USES ONLY 1/3 OF SEGMENTS
04000		IF(PLT.GE.0)GO TO 21
04100		TWICE=0
04200		KQ=1
04300		RWID=.2
04400		IF(RHT.LT.2)GO TO 21
04500		TWICE=1
04600		RWID=.14
04700	C  IF SIZE IS GT.2 3 SLURS ARE DRAWN
04800	21	RST7=RSTJ2*7.
04900		RQQ=R5-R4
05000		IF(R6.GT.1000)CALL RNOTE(R6)
05100		GO TO (5,6,7),J8+4
05200		GO TO 4
05300	5	R=32
05400	C AFTER DOTTED NOTE
05500		GO TO 8
05600	6	R=22
05700	C BETWEEN NOTES
05800	8	RX=-1.3
05900		GO TO 9
06000	7	R=7
06100		RX=RSTJ2
06200	9	CALL RJBX(R)
06300		R6=R6+RX
06400	4	RXX=RHORZ(R6)-R3
06500		RTILT=RQQ*RST7
06600	80	RX=SQRT(RXX**2+RTILT**2)
06700		IF(J8.NE.-1)GO TO 10
06800		IF(RQQ.GT.8)RQQ=8
06900		IF(RQQ.LT.-8)RQQ=-8
07000		RQQ=RQQ*RSTFAC(J2)*1.0
07100		IF(R7)RQQ=-RQQ
07200		R3=R3-RQQ
07300	C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
07400	10	RJ=ABS(R7)
07500	C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.(300 NOT DONE)
07600		IF(RJ.LT.100)RJ=-1
07700		IF(RJ.GE.300)RJ=0
07800		R7=AMOD(R7,100.0)
07900	1	R=CENTR
08000		IF(J8.GT.0)GO TO 180
08100		L=72
08200	C  FOR BRACKETS
08300		CALL SLOOP
08400	CF	RB=RX/71.
08500	CF	DO 81 K=0,71
08600	CF81	SLURX(K+1)=RB*(K)+R3
08700	CF	RA=R7*RST7
08800	CF41	IF(R9.EQ.0)R9=RZZ
08900	CF	R=R+RA
09000	CF	L=0
09100	CF	DO 40 K=36,1,-1
09200	CF	L=L+1
09300	CF	RW=R-RA*(K/36.)**R9
09400	CF	SLURY(L)=RW
09500	CF40	SLURY(73-L)=RW
09600	CF	L=72
09700	
09800	CF89	IF(RTILT.EQ.0)GO TO 87
09900	CF	RW=ATAN2(RTILT,RXX)
10000	CF	RA=SIN(RW)
10100	CF	RB=COS(RW)
10200	CF	RZ=SLURX(1)
10300	CF	RW=SLURY(1)
10400	CF	DO 83 K=1,L
10500	CF	R=SLURX(K)-RZ
10600	CF	RXX=SLURY(K)-RW
10700	CF	SLURX(K)=RB*R-RA*RXX+RZ
10800	CF83	SLURY(K)=RB*RXX+RA*R+RW
10900	
11000	87	IF(J4)CALL LINES(SLURX(J10),SLURY(J10),3)
11100		J5=KQ
11200		J6=J10
11300		J7=L
11400		IF(J4.NE.0)GO TO 22
11500		CALL EXCH(J6,J7)
11600		J5=-1
11700	22	DO 88 K=J6,J7,J5
11800	88	CALL LINES(SLURX(K),SLURY(K),2)
11900		IF(TWICE)RETURN
12000		TWICE=TWICE-1
12100		IF(J8.GT.0)GO TO 182
12200		J4=J4+1
12300		R7=R7+RWID
12400	C  RWID=WIDTH OF SLUR -- SEE DATA
12500		GO TO 1
12600	180	RW=R+R7*RST7
12700		TWICE=-1
12800		KQ=1
12900		RX=RX+R3
13000	CC	RA=(R5-R4)*RST7
13100		IF(J9.EQ.0)GO TO 181
13200		TWICE=2
13300		RZ=RTILT/(RX-R3)
13400		RXX=RX
13500		RWID=(R3+RXX)/2.
13600	182	IF(TWICE.EQ.1)GO TO 183
13700	C  DOES LEFT SIDE FIRST.
13800		IF(TWICE.EQ.0)GO TO 184
13900	C LAST IS NUMBER.
14000		J8=2
14100		RC=RSTJ2*13.
14200		RX=RWID-RC
14300		RWW=RTILT
14400	185	RTILT=RZ*(RX-R3)
14500	
14600	C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.
14700	
14800		GO TO 181
14900	183	J8=3
15000		RX=RXX
15100		RTILT=RWW
15200		RXX=R3
15300		R3=RWID+RC
15400		RXX=RZ*(R3-RXX)
15500		R=R+RXX
15600		RW=RW+RXX
15700		GO TO 185
15800	
15900	181	SLURX(1)=R3
16000		SLURY(1)=R
16100		SLURX(2)=R3
16200		SLURY(2)=RW
16300		SLURX(3)=RX
16400		SLURY(3)=RW+RTILT
16500		SLURX(4)=RX
16600		SLURY(4)=R+RTILT
16700		L=4
16800		IF(J8.EQ.2)L=3
16900		IF(J8.EQ.3)J10=2
17000	CC	TWICE=-1
17100		GO TO 87
17200	184	J3=RWID
17300	C  PUT IN VERT. POS. WHEN SLOPE!
17400		R4=RQQ/2.+R4+R7-1.
17500		R6=1.
17600		R7=1.
17700		R8=0
17800		CALL MAKNUM(R9)
17900		END
18000	C  8, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
18100	C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
18200	
18300	
18400		SUBROUTINE PLTSRT
18500	C  SORTS DATA TO SHORTEN INVISIBLE VECTORS WHEN PLOTTING. 
18600	CF	IMPLICIT INTEGER(S-Z)
18700		COMMON /XRN/RN(4000) /PTR/PWDS(250),ITEM,L,I,IX
18800		DIMENSION  P(250)
18900		CALL PSRT(P)
19000		END
19100	
19200	CF	DO 4 K=1,ITEM
19300	CF	L=PWDS(K)
19400	CF	LL=PWDS(K-1)
19500	CF	LM=PWDS(K+1)
19600	CF	A=RN(L+3)
19700	CF	P(K)=A+1000*RN(L+2)
19800	CF	IF(RN(L+1).NE.16)GO TO 40
19900	CF	Y=PWDS(K-1)
20000	CF	V=PWDS(K+1)
20100	CF	IF(RN(Y+1).EQ.16)GO TO 41
20200	CF	IF(RN(V+1).EQ.16)GO TO 41
20300	CF	GO TO 4
20400	CF40	IF(A.GE.0)GO TO 4
20500	CF41	P(K)=-10000
20600	CF4	CONTINUE
20700	C  PLOTS ALL NEG. POSITIONS FIRST.
20800	CF	IX=I
20900	CF	IF(I.LT.1500)I=1500
21000	CF	Y=I
21100	CF	I=I+IX-1
21200	CF	IX=Y
21300	C  IX IS M IN MAIN PROG.
21400	C  LEAVES 1500 WDS IN RN FOR STORING "NOIR" DATA.
21500	CF2	A=P(1)
21600	CF	L=1
21700	CF	DO 1 K=1,ITEM
21800	CF	IF(A.LE.P(K))GO TO 1
21900	CF	A=P(K)
22000	CF	L=K
22100	CF1	CONTINUE
22200	CF	IF(A.EQ.10000.)RETURN
22300	C  ALL ITEMS HAVE NOW BEEN SHUFFLED
22400	CF	V=PWDS(L)
22500	CF	P(L)=10000
22600	CF	L=RN(V)+2+Y
22700	CF	V=V-Y
22800	CC	CALL LOOP(0,L,1,Y,V,RN)
22900	CF	DO 3 K=Y,L
23000	CF3	RN(K)=RN(K+V)
23100	C  REPLACED SUBROUTINE LOOP
23200	CF	Y=L+1
23300	CF	GO TO 2
23400	CF	END
23500	
23600	
23700	CX	SUBROUTINE LINES(A,B,L)
23800	CX	COMMON /FL/IC,NZ,NX,RZ,XGP
23900	CX	COMMON/DL/IIII,SAVER,AA /PLTR/IPLT,RHT,DIS
24000	CX	COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20) 
24100	CX	COMMON/DPY/GO,TOP,BOT
24200	CX	DATA BB/260.0/,CC/3.5/,DD/1.43/,MX/512/
24300	C  SET XGP TO 1245.0 FOR MARGIN IN XEROX COPIES
24400	CX22	GO TO 23
24500	C  CHANGE ABOVE TO 'J6CL' IN DDT TO USE NEXT ITEMS.
24600	CX24	AA=CC-DD*ABS(A)/BB
24700	C  USE THIS IN DDT TO DISTORT ITEMS.  CC MUST BE > DD
24800	CX	B=B*AA
24900	CX23	IF(IPLT)GO TO 2
25000	CX	IF(JA.EQ.44)RETURN
25100	CC	K=B
25200	CC	IF(K.GT.ITOP)ITOP=B
25300	CC	IF(K.LT.IBOT)IBOT=B
25400	CX	IF(B.GT.TOP)TOP=B
25500	CX	IF(B.LT.BOT)BOT=B
25600	CX6	RETURN
25700	CC2	IF(IPLT.EQ.-2)RETURN
25800	C RXGP SETS UP-DOWN POS. ON XEROX PAPER (FRACTIONAL POSITIONS POSSIBLE.)
25900	CC	IF(IXRX.EQ.0)GO TO 9
26000	CC	M=ROFF(RXGP-B*RHT)
26100	CC	N=ROFF(XGP+A*DIS)
26200	CC	GO TO 8
26300	CX2	M=ROFF(A*DIS)
26400	CX	N=ROFF(B*RHT)
26500	CX8	CALL PLOT(M,N,L)
26600	CX	END